home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Misc.mlp < prev    next >
Encoding:
Text File  |  1996-07-03  |  5.3 KB  |  194 lines  |  [TEXT/R*ch]
  1. (* Misc.sml *)
  2.  
  3. fun (g o f) x = g (f x);
  4. fun a before (b: unit) = a;
  5.  
  6. exception Option;            (* belongs in General *)
  7.  
  8. fun getOpt (SOME v, _) = v
  9.   | getOpt (NONE,   a) = a;
  10.  
  11. fun isSome (SOME _) = true 
  12.   | isSome NONE     = false;
  13.  
  14. fun valOf (SOME v) = v
  15.   | valOf NONE     = raise Option;
  16.  
  17. (* The definitions below implement the requirement that units
  18.    Char, String and List are partially opened in the initial environment.
  19.  *)
  20.  
  21. val chr = Char.chr;
  22. val ord = Char.ord;
  23.  
  24. val explode = String.explode;
  25. val implode = String.implode;
  26. val concat = String.concat;
  27. val str = String.str;
  28.  
  29. exception Empty = List.Empty;
  30. val op @ = List.@;
  31. val app = List.app;
  32. val foldl = List.foldl;
  33. val foldr = List.foldr;
  34. val hd = List.hd;
  35. val length = List.length;
  36. val map = List.map;
  37. val null = List.null;
  38. val rev = List.rev;
  39. val tl = List.tl;
  40.  
  41. val vector = Vector.fromList;
  42.  
  43. (* Help -- a simple Moscow ML library browser, PS 1995-04-30
  44.  
  45. Uses argv_ to get the library directory, then reads and displays
  46. (signature) files from that directory.
  47.  
  48. The search facility cyclically searches for occurrences of a given
  49. string, and displays the line in which the string was found, as close
  50. to the center of the display (or portion displayed) as possible.
  51.  
  52. Could use Config.normalizedUnitName to show the proper unit names
  53. under DOS, but that would create a dependency on the compiler structures.
  54.  
  55. *)
  56.  
  57. #ifdef macintosh
  58. val slash = #":"
  59. #else (* DOS/UNIX *)
  60. val slash = #"/"
  61. #endif  
  62.  
  63. local 
  64. open BasicIO
  65. fun min (x, y) = if x < y then x else y : int;
  66. fun max (x, y) = if x < y then y else x : int;
  67.  
  68. fun getstdlib () = 
  69.     let open Vector
  70.     prim_val argv_ : string vector = 0 "command_line";
  71.     val stop = length argv_ - 1;
  72.     fun h i = 
  73.         if i < stop then 
  74.         if sub(argv_, i) = "-stdlib" then sub(argv_, i+1)
  75.         else h (i+1)
  76.         else
  77.         raise Fail "Cannot find the standard libraries!"
  78.     in h 0 end;
  79.  
  80. fun show name (strs : string Vector.vector) = 
  81.     let prim_val sub_ : string -> int -> char = 2 "get_nth_char";
  82.     val lines = Vector.length strs
  83.     val sought = ref NONE 
  84.     fun instr s str =
  85.         let val len = String.size s
  86.         fun eq j k = 
  87.             j >= len orelse 
  88.             sub_ s j = Char.toLower (sub_ str k) andalso eq (j+1) (k+1)
  89.         val stop = String.size str - len
  90.         fun cmp k = k<=stop andalso (eq 0 k orelse cmp(k+1))
  91.         in cmp 0 end;
  92.     fun occurshere str = 
  93.         case !sought of
  94.         NONE   => false
  95.           | SOME s => instr s str
  96.     fun findline s curr = 
  97.         let fun h i = 
  98.         if i >= lines then NONE
  99.         else if instr s (Vector.sub(strs, (i+curr) rem lines)) then 
  100.             SOME ((i + curr) rem lines)
  101.         else h(i+1)
  102.         in h 0 end
  103.     val portion = 23
  104.     fun wait next = 
  105.         let val prompt = 
  106.         "---- " ^ name ^ "[" ^ 
  107.         makestring(floor(100.0 * real next / real lines)) 
  108.         ^ "%]: down, up, bottom, top, /(find), next, quit: "
  109.         fun toend () = (say "\n....\n"; 
  110.                 nextpart (lines - portion) portion)
  111.         fun tobeg () = (say "\n....\n"; nextpart 0 portion)
  112.         fun up   ()  = (say "\n....\n"; 
  113.                 nextpart (next-3*portion div 2) portion)
  114.         fun down ()  = if next=lines then toend()
  115.                    else nextpart next (portion div 2)
  116.         fun find s =
  117.             case findline s next of
  118.             NONE      => 
  119.                 (say ("**** String \"" ^ s ^ "\" not found\n"); 
  120.                  wait next)
  121.               | SOME line => 
  122.                 (say "\n....\n";
  123.                  nextpart (line - portion div 2) portion)
  124.         fun search chars = 
  125.             let fun stripnl []           = []
  126.               | stripnl (#"\n" :: _) = []
  127.               | stripnl (c :: cr)    = Char.toLower c :: stripnl cr
  128.             val s = implode (stripnl chars)
  129.             in sought := SOME s; find s end
  130.         fun findnext () =
  131.             (case !sought of
  132.              NONE   => (say "**** No previous search string\n"; 
  133.                     wait next)
  134.                | SOME s => find s)
  135.         in 
  136.         say prompt;
  137.         case explode(input_line std_in) of
  138.             []        => ()
  139.           | #"q" :: _ => ()
  140.           | #"u" :: _ => up ()
  141.           | #"d" :: _ => down ()
  142.           | #"t" :: _ => tobeg ()
  143.           | #"g" :: _ => tobeg ()
  144.           | #"b" :: _ => toend ()
  145.           | #"G" :: _ => toend ()
  146.                   | #"/" :: s => search s
  147.                   | #"n" :: s => findnext ()
  148.           | _         => if next=lines then toend ()
  149.                  else nextpart next portion
  150.         end
  151.     and nextpart first amount = 
  152.         let val start = min(lines, max(first, 0))
  153.         val stop  = min(start + amount, lines)
  154.         in prt wait start stop end
  155.     and prt wait i stop = 
  156.         if i >= stop then wait i
  157.         else 
  158.         let val line = Vector.sub(strs, i) 
  159.         in 
  160.             if occurshere line then say "@>" else say "+ ";
  161.             say line; 
  162.             prt wait (i+1) stop
  163.         end
  164.     in 
  165.     say "\n";
  166.     if lines <= portion then prt ignore 0 lines
  167.     else nextpart 0 portion
  168.     end
  169.  
  170. fun readfile file = 
  171.     let fun extnd dir =
  172.         (if String.size dir > 0 
  173.         andalso String.sub(dir, String.size dir - 1) = slash 
  174.          then dir
  175.          else dir ^ String.str slash) ^ file
  176.         val is = open_in_bin (extnd (getstdlib ()))  
  177.     fun h () = if end_of_stream is then []
  178.            else input_line is :: h ()
  179.     in Vector.fromList (h ()) end;
  180. in
  181. fun help "" =
  182.     show "help" 
  183.      #["Moscow ML library browser: \n",
  184.        "\n",
  185.        "   help \"lib\";   gives an overview of the library units\n",
  186.        "   help \"U\";     provides help on library unit U\n",
  187.        "\n"]
  188.   | help "lib" = show "Overview" (readfile "README")
  189.   | help "README" = show "README" (readfile "README")
  190.   | help unit = 
  191.     show unit (readfile (unit ^ ".sig"))
  192.     handle Io _ => say "\nUnknown unit.  Try:\n\n   help \"\";\n\n"
  193. end
  194.